home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / comm / bbs / Hydra11s.lha / HBBS / Source / Oberon / UserQuery.mod < prev    next >
Text File  |  1996-07-07  |  13KB  |  487 lines
  1. MODULE UserQuery;
  2.  
  3.     IMPORT
  4.     a:= Arguments, ac:= ANSIConsole, st:= Strings, cv:= Conversions, io, s:= SYSTEM,
  5.     e:= Exec, d:= Dos, ol:= OberonLib,
  6.     bo:= BBSColours, bs:= BBSStructures, bc:= BBSConstants,
  7.     hn:= HBBSNode, hc:= HBBSCommon, req:= Requests;
  8.  
  9.  
  10.     CONST EOF = -1; LF = 0AH;
  11.       LineLength = 80;
  12.       LTRUE = 1; LFALSE = 0;
  13.  
  14.     TYPE
  15.     LineNodePtr = UNTRACED POINTER TO LineNode;
  16.     LineNode = STRUCT
  17.         prev, next: LineNodePtr;
  18.         text: ARRAY LineLength OF CHAR;
  19.     END;
  20.  
  21.     VAR
  22.     BBSGlobal: bs.BBSGlobalDataPtr;
  23.     NnD: bs.NodeDataPtr;
  24.     NodeNum: LONGINT;
  25.     argList: LineNodePtr;
  26.     CountArgs: INTEGER;
  27.     textPool: e.MemPoolPtr;
  28.     menuName: LineNodePtr;
  29.  
  30.     PROCEDURE cleanup(num: LONGINT);
  31.     BEGIN
  32.     IF hn.HBBSNodeBase # NIL THEN
  33.         hn.HBBSCleanUpDoor;
  34.         e.CloseLibrary(hn.HBBSNodeBase);
  35.         hn.HBBSNodeBase:= NIL;
  36.     END;
  37.     IF hc.HBBSCommonBase # NIL THEN
  38.         hc.HBBSCleanUpCommon;
  39.         e.CloseLibrary(hc.HBBSCommonBase);
  40.         hc.HBBSCommonBase:= NIL;
  41.     END;
  42.  
  43.     IF num # 0 THEN
  44.         io.WriteString("Door Error = ");
  45.         io.WriteInt(num, 0); io.WriteLn;
  46.          (* io.Format("Door Error = %d\n", s.ADR(num)) *)
  47.     END;
  48.     END cleanup;
  49.  
  50.     PROCEDURE init(name: e.STRPTR);
  51.     BEGIN
  52.     
  53.     IF hc.HBBSCommonBase = NIL THEN
  54.         cleanup(1); RETURN
  55.     END;
  56.     IF NOT hc.HBBSInitCommon() THEN
  57.         cleanup(2); RETURN
  58.     END;
  59.  
  60.     IF hn.HBBSNodeBase = NIL THEN
  61.         cleanup(3); RETURN
  62.     END;
  63.  
  64.     IF NOT hn.HBBSInitDoor(SHORT(NodeNum), name) THEN
  65.         cleanup(4); RETURN
  66.     END;
  67.  
  68.     END init;
  69.  
  70.     PROCEDURE AddNode(VAR list: LineNodePtr; at: INTEGER): LineNodePtr;
  71.     VAR last, new: LineNodePtr;
  72.         dummy: LineNode;
  73.     BEGIN
  74.     new:= e.AllocPooled(textPool, s.SIZE(dummy));
  75.     IF list = NIL THEN
  76.         IF new # NIL THEN
  77.         new^.prev:= NIL;
  78.         new^.next:= NIL;
  79.         END;
  80.         list:= new;
  81.     ELSE
  82.         IF at <= 1 THEN
  83.         IF new # NIL THEN
  84.             new^.prev:= NIL;
  85.             new^.next:= list;
  86.             list^.prev:= new;
  87.             list:= new;
  88.         END;
  89.         ELSE
  90.         last:= list;
  91.         WHILE (last^.next # NIL) & (at > 2) DO
  92.             last:= last^.next; at:= at - 1
  93.         END;
  94.         IF new # NIL THEN
  95.             new^.next:= last^.next;
  96.             new^.prev:= last;
  97.             IF last^.next # NIL THEN
  98.             last^.next^.prev:= new
  99.             END;
  100.             last^.next:= new;
  101.         END;
  102.         END;
  103.     END;
  104.     RETURN new;
  105.     END AddNode;
  106.  
  107.     PROCEDURE DeleteNode(VAR list: LineNodePtr; at: INTEGER);
  108.     VAR this: LineNodePtr;
  109.         dummy: LineNode;
  110.     BEGIN
  111.     IF list # NIL THEN
  112.         this:= list;
  113.         IF at <= 1 THEN
  114.         list:= this^.next;
  115.         IF list # NIL THEN list^.prev:= NIL END;
  116.         ELSE
  117.         WHILE (this^.next # NIL) & (at > 1) DO
  118.             this:= this^.next; at:= at - 1
  119.         END;
  120.         IF this^.prev # NIL THEN
  121.             this^.prev^.next:= this^.next
  122.         END;
  123.         IF this^.next # NIL THEN
  124.             this^.next^.prev:= this^.prev;
  125.         END;
  126.         END;
  127.         e.FreePooled(textPool, this, s.SIZE(dummy));
  128.     END;
  129.     END DeleteNode;
  130.  
  131.     PROCEDURE GetNode(list: LineNodePtr; at: INTEGER): LineNodePtr;
  132.     BEGIN
  133.     IF list = NIL THEN RETURN NIL END;
  134.     WHILE (list # NIL) & (at > 1) DO
  135.         list:= list^.next; at:= at - 1;
  136.     END;
  137.     RETURN list;
  138.     END GetNode;
  139.  
  140.     PROCEDURE ReqNumber(l: LONGINT);
  141.     VAR str: ARRAY 80 OF CHAR;
  142.         ok: BOOLEAN;
  143.         count: INTEGER; factor: LONGINT;
  144.     BEGIN
  145.     factor:= 1000000000; count:= 10;
  146.     WHILE (ABS(l) < factor) & (count > 1) DO count:= count - 1; factor:= factor DIV 10 END;
  147.     ok:= cv.IntToString(l, str, count);
  148.     IF ok THEN
  149.         req.BreakPoint(str)
  150.     END;
  151.     END ReqNumber;
  152.  
  153.     VAR str: ARRAY 80 OF CHAR;
  154.  
  155.     PROCEDURE PutNumber(l: LONGINT);
  156.     VAR ok: BOOLEAN;
  157.         count: INTEGER; factor: LONGINT;
  158.     BEGIN
  159.     factor:= 1000000000; count:= 10;
  160.     WHILE (ABS(l) < factor) & (count > 1) DO count:= count - 1; factor:= factor DIV 10 END;
  161.     ok:= cv.IntToString(l, str, count);
  162.     IF ok THEN
  163.         hn.DOORWriteText(s.ADR(str));
  164.     END;
  165.     END PutNumber;
  166.  
  167.     VAR str1: ARRAY 2 OF CHAR;
  168.  
  169.     PROCEDURE PutChar(ch: CHAR);
  170.     BEGIN
  171.     str1[0]:= ch; str1[1]:= CHR(0);
  172.     hn.DOORWriteText(s.ADR(str1));
  173.     END PutChar;
  174.  
  175.     PROCEDURE ReplyArgs;
  176.     VAR
  177.         i: INTEGER;
  178.         thisArg: LineNodePtr;
  179.     BEGIN
  180.     i:= 1;
  181.     LOOP
  182.         thisArg:= GetNode(argList, i);
  183.         IF thisArg # NIL THEN hn.DOORWriteText(s.ADR(thisArg^.text)) END; 
  184.         hn.DOORWriteText(s.ADR(" "));
  185.         IF thisArg = NIL THEN EXIT END;
  186.         i:= i + 1
  187.     END;
  188.     END ReplyArgs;
  189.  
  190.     CONST
  191.     SearchNone = 0; SearchNew = 1; SearchLocked = 2; SearchGlobal = 3;
  192.  
  193.     VAR
  194.     sysopOptions, showDeleted: BOOLEAN;
  195.     searchType: INTEGER;
  196.     sysopFlag: LONGINT;
  197.  
  198.     PROCEDURE GetStringAt(row, column: INTEGER; len: LONGINT; VAR str: ARRAY OF CHAR): BOOLEAN;
  199.     VAR res: LONGINT;
  200.     BEGIN
  201.     ac.CURSORGoTo(PutChar, row, column); ac.EraseToEOL(PutChar);
  202.     ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeWhite);
  203.     res:= hn.DOORGetLine(bc.GlDisplay + bc.GlNoOLM + bc.GlEdit + sysopFlag, CHR(0), len, 0, s.ADR(str));
  204.     IF (res = bc.InGotLine) THEN
  205.         hc.strNcpy(s.ADR(str), NnD^.CurrentLine, SHORT(len));
  206.         RETURN TRUE;
  207.     ELSE
  208.         str:= "";
  209.         RETURN FALSE
  210.     END;
  211.     END GetStringAt;
  212.  
  213.     PROCEDURE WriteBoolAt(row, column: INTEGER; b: BOOLEAN);
  214.     BEGIN
  215.     ac.CURSORGoTo(PutChar, row, column);
  216.     ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeWhite);
  217.     IF b THEN hn.DOORWriteText(s.ADR("Y")) ELSE hn.DOORWriteText(s.ADR("N")) END;
  218.     ac.SetStyle(PutChar, ac.stPlain); ac.SetColor(PutChar, ac.cForeWhite);
  219.     IF b THEN hn.DOORWriteText(s.ADR("es")) ELSE hn.DOORWriteText(s.ADR("o ")) END;
  220.     END WriteBoolAt;
  221.  
  222.     PROCEDURE DisplayUser(userData: bs.UserDataPtr);
  223.     BEGIN
  224.     ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeWhite);
  225.     hn.DOORWriteText(s.ADR("#"));
  226.     PutNumber(userData^.UserID);
  227.     IF userData^.UserID >= 100 THEN hn.DOORWriteText(s.ADR(" "));
  228.     ELSIF userData^.UserID >= 10 THEN hn.DOORWriteText(s.ADR("  "));
  229.     ELSE hn.DOORWriteText(s.ADR("   "));
  230.     END;
  231.     IF userData^.Status = bc.UserNew             THEN ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeYellow);
  232.     ELSIF userData^.Status = bc.UserValidated    THEN ac.SetStyle(PutChar, ac.stPlain); ac.SetColor(PutChar, ac.cForeGreen);
  233.     ELSIF userData^.Status = bc.UserLoginsDenied THEN ac.SetStyle(PutChar, ac.stPlain); ac.SetColor(PutChar, ac.cForeRed);
  234.     ELSIF userData^.Status = bc.UserDeleted      THEN ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeBlack);
  235.     ELSIF userData^.Status = bc.UserOverwritable THEN ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeBlue);
  236.     ELSE ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForePurple);
  237.     END;
  238.     hn.DOORWriteText(s.ADR(userData^.Handle));
  239.  
  240.     END DisplayUser;
  241.  
  242.     PROCEDURE DisplayWait(VAR sWait: ARRAY OF CHAR);
  243.     BEGIN
  244.     st.Append(sWait, ".");
  245.     ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeWhite);
  246.     hn.DOORWriteText(s.ADR(sWait));
  247.     END DisplayWait;
  248.  
  249.     PROCEDURE UserPromptAt(row, column: INTEGER): LONGINT;
  250.     VAR
  251.         str: ARRAY 50 OF CHAR;
  252.         res: LONGINT;
  253.         val: LONGINT;
  254.     BEGIN
  255.     ac.CURSORGoTo(PutChar, row, column);
  256.     ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeYellow);
  257.     hn.DOORWriteText(s.ADR("User ID# or RETURN to continue > "));
  258.     ac.SetColor(PutChar, ac.cForeWhite);
  259.     str:= "";
  260.     res:= hn.DOORGetLine(bc.GlDisplay + bc.GlNoOLM + bc.GlEdit + sysopFlag, CHR(0), 50, 0, s.ADR(str));
  261.     IF (res = bc.InGotLine) THEN hc.strNcpy(s.ADR(str), NnD^.CurrentLine, 50);
  262.     ELSE str:="";
  263.     END;
  264.     IF NOT cv.StringToInt(str, val) THEN val:= -1 END;
  265.     IF st.Length(str) = 0 THEN val:= -1 END; (* canceled *)
  266.     RETURN val;
  267.     END UserPromptAt;
  268.  
  269.     PROCEDURE CallZoom(userID: LONGINT);
  270.     VAR options, s2: ARRAY 40 OF CHAR;
  271.         res: LONGINT;
  272.     BEGIN
  273.     IF userID >= 0 THEN
  274.         options:= "USERID=";
  275.         cv.IntToStringLeft(userID, s2);
  276.         st.Append(options, s2);
  277.         res:= hn.DOORUserDoor(s.ADR("UserInfos"), s.ADR(options));
  278.         res:= hn.DOORDisplaySpecialScreen(s.ADR("USERQUERY"));
  279.     END;
  280.     END CallZoom;
  281.  
  282.     PROCEDURE SearchUser(searchType: INTEGER; deletedUsers: BOOLEAN; sRealName, sHandle: ARRAY OF CHAR; fillArea: BOOLEAN);
  283.  
  284.     CONST
  285.         startRow = 3; endRow = 20;
  286.     VAR
  287.         nUsers, iPos: INTEGER;
  288.         userData: bs.UserData;
  289.         sWait, str, options, s2: ARRAY 25 OF CHAR;
  290.         accept: BOOLEAN;
  291.         rowCount: INTEGER;
  292.         res, userID: LONGINT;
  293.  
  294.     PROCEDURE FillArea;
  295.         VAR i: INTEGER;
  296.     BEGIN
  297.         ac.CURSORGoTo(PutChar, startRow, 40);
  298.         FOR i:= startRow TO endRow DO
  299.         ac.EraseToEOL(PutChar); ac.DOWN(PutChar, 1);
  300.         END;
  301.     END FillArea;
  302.  
  303.     BEGIN
  304.     nUsers:= SHORT(BBSGlobal^.TotalUsers);
  305.     iPos:= 1; sWait:= ""; rowCount:= startRow;
  306.     st.Upper(sRealName); st.Upper(sHandle);
  307.     IF fillArea THEN FillArea END;
  308.     ac.CURSORGoTo(PutChar, startRow - 1, 40);
  309.  
  310.     WHILE iPos <= nUsers DO
  311.  
  312.         IF hc.HBBSLoadUser(iPos, NIL, NIL, s.VAL(bs.UserDataPtr, s.ADR(userData))) THEN
  313.         IF searchType = SearchNew THEN accept:= (userData.Status = bc.UserNew);
  314.         ELSIF searchType = SearchLocked THEN accept:= (userData.Status = bc.UserLoginsDenied);
  315.         ELSIF NOT deletedUsers THEN accept:= ((userData.Status # bc.UserDeleted) & (userData.Status # bc.UserOverwritable));
  316.         ELSE accept:= TRUE;
  317.         END;
  318.         IF st.Length(sHandle) > 0 THEN
  319.             hc.strNcpy(s.ADR(str), s.ADR(userData.Handle), 25); st.Upper(str);
  320.             accept:= accept & (st.Occurs(str, sHandle) = 0);
  321.         END;
  322.         IF st.Length(sRealName) > 0 THEN
  323.             hc.strNcpy(s.ADR(str), s.ADR(userData.RealName), 25); st.Upper(str);
  324.             accept:= accept & (st.Occurs(str, sRealName) = 0);
  325.         END;
  326.  
  327.         ELSE
  328.         accept:= FALSE;
  329.         END;
  330.  
  331.         IF accept THEN
  332.         hn.DOORWriteText(s.ADR("\r\n")); ac.RIGHT(PutChar, 39);
  333.         DisplayUser(s.VAL(bs.UserDataPtr, s.ADR(userData)));
  334.         IF (rowCount = endRow) AND (iPos # nUsers) THEN
  335.             userID:= UserPromptAt(endRow + 1, 5);
  336.             ac.CURSORGoTo(PutChar, endRow+1, 5);
  337.             ac.EraseToEOL(PutChar);
  338.             CallZoom(userID);
  339.             rowCount:= startRow;
  340.             IF NOT(iPos = nUsers) THEN FillArea END;
  341.             ac.CURSORGoTo(PutChar, startRow - 1, 40);
  342.         ELSE
  343.             INC(rowCount);
  344.         END;
  345.         ELSE
  346.         (* ac.CURSORGoTo(PutChar, rowCount, 40);
  347.         DisplayWait(sWait);
  348.         ac.UP(PutChar, 1); *)
  349.         END;
  350.         INC(iPos);
  351.     END;
  352.     userID:= UserPromptAt(endRow + 1, 5);
  353.     ac.CURSORGoTo(PutChar, endRow+1, 5);
  354.     ac.EraseToEOL(PutChar);
  355.     IF userID >= 0 THEN
  356.         CallZoom(userID);
  357.     END;
  358.     END SearchUser;
  359.  
  360.     PROCEDURE DoorMain;
  361.  
  362.     VAR res: LONGINT;
  363.         sLine: ARRAY 10 OF CHAR;
  364.         sHandle, sRealName: ARRAY 25 OF CHAR;
  365.         fillArea: BOOLEAN;
  366.         argLine: LineNodePtr;
  367.     BEGIN
  368.     showDeleted:= FALSE;
  369.     sysopOptions:= st.Occurs(NnD^.ActiveDoor^.SystemOptions^, "SYSOP") >= 0;
  370.     searchType:= SearchNone;
  371.     sHandle:= ""; sRealName:= "";
  372.     fillArea:= FALSE;
  373.  
  374.     IF NnD^.NodeDevice.SysopNode = bc.LTRUE THEN sysopFlag:= bc.GlSysop ELSE sysopFlag:= 0 END;
  375.  
  376.     IF hn.DOORDisplaySpecialScreen(s.ADR("USERQUERY")) = bc.LTRUE THEN
  377.  
  378.         IF sysopOptions THEN WriteBoolAt(8, 23, showDeleted) END;
  379.  
  380.         LOOP
  381.         ac.CURSORGoTo(PutChar, 21, 0);
  382.         res:= hn.DOORGetLine(bc.GlImmediate + bc.GlNoReturn + bc.GlNoOLM + sysopFlag, CHR(0), 1, 0, NIL);
  383.  
  384.         IF (res = bc.InGotLine) OR (res = bc.InImmediate) THEN
  385.  
  386.             hc.strNcpy (s.ADR(sLine), NnD^.CurrentLine, LEN(sLine));
  387.  
  388.             hc.CVTUCase(s.ADR(sLine));
  389.  
  390.             IF st.Occurs(sLine, "R") >= 0 THEN
  391.             IF NOT GetStringAt(4, 23, 25, sRealName) THEN EXIT END;
  392.             ELSIF st.Occurs(sLine, "H") >= 0 THEN
  393.             IF NOT GetStringAt(6, 23, 25, sHandle) THEN EXIT END;
  394.             ELSIF (st.Occurs(sLine, "D") >= 0) AND sysopOptions THEN
  395.  
  396.             ac.CURSORGoTo(PutChar, 8, 23);
  397.             res:= hn.DOORGetLine(bc.GlImmediate + bc.GlNoReturn, CHR(0), 1, 0,NIL);
  398.  
  399.             IF (res = bc.InGotLine) OR (res = bc.InImmediate) THEN
  400.  
  401.                 hc.strNcpy(s.ADR(sLine), NnD^.CurrentLine, 1);
  402.                 hc.CVTUCase(s.ADR(sLine));
  403.                 showDeleted:= st.Occurs(sLine, "Y") >= 0;
  404.                 WriteBoolAt(8, 23, showDeleted);
  405.             END;
  406.  
  407.             ELSIF (st.Occurs(sLine, "N") >= 0) AND sysopOptions THEN
  408.             searchType:= SearchNew;
  409.             ELSIF (st.Occurs(sLine, "L") >= 0) AND sysopOptions THEN
  410.             searchType:= SearchLocked;
  411.             ELSIF ((st.Occurs(sLine, "G") >= 0) AND sysopOptions)
  412.             OR ((st.Occurs(sLine, "S") >= 0) AND NOT sysopOptions) THEN
  413.             searchType:= SearchGlobal;
  414.             ELSIF (st.Occurs(sLine, "Q") >= 0) OR (st.Length(sLine) = 0)  THEN
  415.             EXIT
  416.             END;
  417.  
  418.             IF (searchType # SearchNone) THEN
  419.             SearchUser(searchType, showDeleted, sRealName, sHandle, fillArea);
  420.             searchType:= SearchNone; fillArea:= TRUE
  421.             END;
  422.  
  423.         ELSE
  424.             EXIT
  425.         END;
  426.         END;
  427.  
  428.     ELSE
  429.         IF hn.DOORPausePrompt(s.ADR("User query menu not found... press any key to abort")) = bc.LTRUE THEN END;
  430.     END;
  431.  
  432.     END DoorMain;
  433.  
  434.     PROCEDURE ParseArgs;
  435.     VAR
  436.         i: INTEGER;
  437.         newArg: LineNodePtr;
  438.         s: ARRAY 80 OF CHAR;
  439.         ok: BOOLEAN;
  440.     BEGIN
  441.     CountArgs:= a.NumArgs();
  442.     i:= 1;
  443.     WHILE i <= CountArgs DO
  444.         newArg:= AddNode(argList, MAX(INTEGER));
  445.         IF newArg # NIL THEN
  446.         a.GetArg(i, newArg^.text);
  447.         ELSE
  448.         CountArgs:= i;
  449.         END;
  450.         i:= i + 1
  451.     END;
  452.     END ParseArgs;
  453.  
  454.  
  455.     VAR
  456.     newArg: LineNodePtr;
  457.     dummy: LineNode;
  458.  
  459. BEGIN
  460.     textPool:= e.CreatePool(LONGSET{}, s.SIZE(dummy), s.SIZE(dummy));
  461.     ParseArgs;
  462.     IF CountArgs > 0 THEN
  463.      newArg:= GetNode(argList, 1);
  464.      IF cv.StringToInt(newArg^.text, NodeNum) THEN
  465.         init(s.ADR("Query user(s)"));
  466.         IF hc.HBBSCommonBase # NIL THEN
  467.         BBSGlobal:= hc.HBBSGimmeBBS();
  468.         IF BBSGlobal # NIL THEN
  469.             NnD:= hc.HBBSNodeDataPtr(SHORT(NodeNum));
  470.             IF NnD # NIL THEN
  471.             DoorMain;
  472.             END;
  473.         END;
  474.         END;
  475.         cleanup(0);
  476.     ELSE
  477.         io.WriteString("Invalid Param for door!\n")
  478.     END;
  479.     ELSE
  480.     io.WriteString("No Param for door!\n");
  481.     END;
  482. CLOSE
  483.     cleanup(0);
  484.     e.DeletePool(textPool);
  485. END UserQuery.
  486.  
  487.